perm filename READX.F4[EMS,LCS] blob
sn#722190 filedate 1983-08-02 generic text, type T, neo UTF8
C*** CALLED BY TRANSF.F4 *********
SUBROUTINE READX(N)
C READS IN TWO FILES FOR TRANSFORMATION
IMPLICIT INTEGER (X-Z)
DIMENSION RN(3)
C RN WILL HOLD FILE NAMES
COMMON /A/X1(800),Y1(800),Z1(800),K1
COMMON /B/X2(800),Y2(800),Z2(800),K2
COMMON /C/X3(800),Y3(800),Z3(800),K3
1 FORMAT(' TYPE FILE NAME '$)
2 FORMAT(A5)
3 FORMAT(4I)
WRITE(5,1)
READ(5,2)RN(N)
NUM=1
REWIND NUM
CALL IFILE(NUM,RN(N))
GO TO (10,20),N
C K1 AND K2 WILL HOLD TOTAL OF POINTS.
10 K1=1
100 READ(NUM,3,END=12)K,X1(K1),Y1(K1),Z1(K1)
K1=K1+1
GO TO 100
12 K1=K1-1
RETURN
20 K2=1
200 READ(NUM,3,END=11)K,X2(K2),Y2(K2),Z2(K2)
K2=K2+1
GO TO 200
11 K2=K2-1
END
SUBROUTINE REVERS
C REVERSES A AND B DATA. B MUST BE GREATER
COMMON /A/X1(800),Y1(800),Z1(800),K1
COMMON /B/X2(800),Y2(800),Z2(800),K2
COMMON /C/X3(800),Y3(800),Z3(800),K3
DO 1 K=1,K1
X3(K)=X1(K)
Y3(K)=Y1(K)
1 Z3(K)=Z1(K)
K3=K1
DO 27 K=1,K2
X1(K)=X2(K)
Y1(K)=Y2(K)
27 Z1(K)=Z2(K)
K1=K2
DO 3 K=1,K3
X2(K)=X3(K)
Y2(K)=Y3(K)
3 Z2(K)=Z3(K)
K2=K3
END
SUBROUTINE FINDO(J,JOUT)
DIMENSION J(1)
DO 1 K=2,JOUT
1 IF(J(K).NE.0)GO TO 2
2 JOUT=K-1
C TOTAL POINTS IN OUTLINE
END
SUBROUTINE OUTPUT
IMPLICIT INTEGER (X-Z)
COMMON /A/X1(800),Y1(800),Z1(800),K1
COMMON /B/X2(800),Y2(800),Z2(800),K2
COMMON /C/X3(800),Y3(800),Z3(800),K3
1 FORMAT(' TYPE OUTPUT FILE NAME '$)
2 FORMAT(A5)
TYPE 1
ACCEPT 2,NAM
IF(NAM.NE.'DPY')GO TO 20
3 FORMAT(3I4,I2,3X,3I4,I2,3X,3I4,I2,3X,3I4,I2)
J=K3/4+1
DO 4 K=1,J
L=K+J
M=K+J+J
N=K+J+J+J
TYPE 3,K,X3(K),Y3(K),Z3(K),L,X3(L),Y3(L),Z3(L),
3 M,X3(M),Y3(M),Z3(M),N,X3(N),Y3(N),Z3(N)
4 CONTINUE
PAUSE
20 CALL OFILE(1,NAM)
K1=0
DO 21 K=1,K3
IF(Z3(K).NE.0)GO TO 28
C LOOK FOR REDUNDANT POINTS
J=X3(K)
IF(J.EQ.X3(K+1).AND.J.EQ.X3(K+2))GO TO 21
J=Y3(K)
IF(J.EQ.Y3(K+1).AND.J.EQ.Y3(K+2))GO TO 21
28 K1=K1+1
X1(K1)=X3(K)
Y1(K1)=Y3(K)
Z1(K1)=Z3(K)
21 CONTINUE
22 FORMAT(3I4,I2)
DO 25 K=1,340
IF(K.LT.320)GO TO 25
IF(Z1(K).NE.0)GO TO 200
25 WRITE(1,22)K,X1(K),Y1(K),Z1(K)
200 END FILE 1
NAM=NAM+2
C BE SURE TO USE 5-LETTER NAME ONLY.
CALL OFILE(1,NAM)
M=0
N=K
DO 23 K=N,K1
M=M+1
23 WRITE(1,22)M,X1(K),Y1(K),Z1(K)
END FILE 1
END